home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / yerk / mps231ss.hqx / Mops ƒ / String < prev    next >
Text File  |  1993-02-02  |  6KB  |  256 lines
  1. \ String class.
  2.  
  3. \ This class is changed radically from Neon!  We now keep two offsets into a string
  4. \ - POS and LIM.  POS marks the "current" position, and LIM the "current" end.
  5. \ Most string operations operate on the substring delimited by POS and LIM, which
  6. \ we call the active part of the string. We also keep the size of the string (the
  7. \ real size, that is) in an ivar, so that we can get it quickly without a system
  8. \ call.
  9.  
  10.    $ D    constant    RET            \ Carriage return character
  11.  
  12. : $ER
  13.     setFwind
  14.     cr ." size: " .  ."   pos: " .  ."   lim: " .
  15.     89 die   ;
  16.  
  17. ' $er  -> $err
  18.  
  19. : $=  { addr1 len1 addr2 len2 -- }
  20.     word0  addr1  addr2  len1  len2  pack  w 10
  21.     trap$ a9ed  i->l  ;
  22.  
  23. : NOPEN    ." (not open)"  ;
  24.  
  25.  
  26. :class    STRING    super{ handle }
  27.  
  28.     var    SIZE
  29.     var    POS
  30.     var    LIM
  31.     int    FLAGS
  32.  
  33.  
  34. :m COPYTO:    \ Redefinition of COPYTO: which will disallow a size change
  35.             \ on the copy.  I found it was fairly easy to do this
  36.             \ accidentally, and get into random crash territory.
  37.     copyto: super
  38.     1 put: flags   ;m
  39.  
  40.  
  41. :m MARK_ORIGINAL:
  42. \ Overrides the above check.  Marks a copy as original, so we can change its
  43. \ size.  We hope we know what we're doing.  At least this is a long name
  44. \ which could hardly get typed by accident!!
  45.     clear: flags   ;m
  46.  
  47.  
  48. :m HANDLE:        \ this method returns the handle - replaces get: in super
  49.     inline{ obj @}
  50.     ^base @  ;m
  51.  
  52. :m POS:        \ ( -- pos )
  53.     inline{ get: pos}
  54.     get: pos  ;m
  55.  
  56. :m >POS:    \ ( newpos -- )
  57.     inline{ put: pos}
  58.     put: pos  ;m
  59.  
  60. :m LIM:        \ ( -- lim )
  61.     inline{ get: lim}
  62.     get: lim  ;m
  63.  
  64. :m >LIM:    \ ( newlim -- )
  65.     inline{ put: lim}
  66.     put: lim  ;m
  67.  
  68. :m LEN:        \ ( -- length )
  69.     get: lim  get: pos  -   ;m
  70.  
  71. :m >LEN:    \ ( newlength -- )
  72.     get: pos  +  put: lim  ;m
  73.  
  74.  
  75. :m SKIP:    \ ( n -- )  Increments POS by n.
  76.     inline{ +: pos}
  77.     +: pos  ;m
  78.  
  79. :m MORE:    \ ( n -- )  Increments LIM by n.
  80.     inline{ +: lim}
  81.     +: lim  ;m
  82.  
  83. :m START:    \ Sets POS to 0 (the start of the string).
  84.     inline{ clear: pos}
  85.     clear: pos  ;m
  86.  
  87. :m BEGIN:    \ Sets POS and LIM to 0, ready to begin some operation.
  88.     clear: pos  clear: lim   ;m
  89.  
  90. :m END:        \ Sets POS and LIM to the end of the string.
  91.     get: size  dup  put: pos  put: lim  ;m
  92.  
  93. :m NOLIM:    \ Sets LIM to the end of the string.
  94.     inline{ get: size put: lim}
  95.     get: size  put: lim  ;m
  96.  
  97. :m RESET:    \ Sets POS to 0, and LIM to the end.
  98.     inline{ clear: pos  get: size  put: lim}
  99.     clear: pos  get: size  put: lim  ;m
  100.  
  101. :m STEP:    \ Steps down the string, by setting POS to LIM and
  102.             \ then setting LIM to the end.
  103.     get: lim  put: pos  get: size  put: lim  ;m
  104.  
  105. :m <STEP:    \ Backward step.  Sets LIM to POS, then POS to 0.
  106.     get: pos  put: lim  clear: pos  ;m
  107.  
  108.  
  109. :m NEW:
  110.     0 new: super
  111.     clear: size  clear: pos  clear: lim  clear: flags  ;m
  112.  
  113. :m ?NEW:
  114.     ^base @  nilH <> ?exit  new: self  ;m
  115.  
  116. :m SIZE:    \ ( -- size )
  117.     inline{ get: size}
  118.     get: size   ;m
  119.  
  120. :m SETSIZE:    \ ( newsize -- )
  121.     get: flags  ?error 94        \ Can't do that on a string copy
  122.     dup  setsize: super  put: size  reset: self  ;m
  123.  
  124. :m CLEAR:
  125.     nil?: self  if  new: self  else  0 setsize: self  then  ;m
  126.  
  127. :m GET:        \ ( -- addr len ).  Gets the active part of the string.
  128.     $chk
  129.     ptr: self  get: pos  +  get: lim  get: pos  -  ;m
  130.  
  131. :m ALL:        \ ( -- addr len )    Gets all the string, ignoring POS and LIM.
  132.     ptr: self  size: self  ;m
  133.  
  134. :m 1ST:        \ ( -- c )  Returns the char at POS.
  135.     ptr: self  get: pos  +  c@  ;m
  136.  
  137. :m ^1ST:    \ ( -- addr )  Returns the addr of the char at POS.
  138.     ptr: self  get: pos  +  ;m
  139.  
  140. private
  141.  
  142. :m MUNGER:  { addr1 len1 addr2 len2 -- offs }
  143.         \ Interface to the Toolbox Munger utility
  144.     $chk
  145.     get: flags  ?error 94        \ Can't do that on a string copy
  146.        0                            \ For returned result
  147.     ^base @  get: pos
  148.     addr1 len1  addr2 len2
  149.     trap$ a9e0                    \ call Munger
  150.     size: super  put: size  ;m
  151.  
  152. public
  153.  
  154. :m UC:        \ ( -- addr len )  Converts string to upper case and gets it.
  155.     get: self  2dup  upper  ;m
  156.  
  157.  
  158. :m PUT: { addr len -- }
  159.         \ Replaces entire string with replacement string.  Does NEW:
  160.         \ if not already done.
  161.     ?new: self  clear: pos
  162.     0 -1  addr len  munger: self  put: lim  ;m
  163.  
  164. :m ->:  { str \ state -- }
  165.         \ Replaces self with the active part of string str.  We assume
  166.         \ the type, and early bind.  As the replacement may cause the
  167.         \ Mem Manager to move things, we lock str for the duration.
  168.  
  169.     str getState: string  -> state   str lock: string
  170.     str get: string   put: self
  171.     state   str setState: string   ;m
  172.  
  173.     
  174. :m INSERT:  { addr len -- }
  175.     ?new: self
  176.     addr 0 addr len  munger: self  put: pos
  177.     len +: lim  ;m
  178.  
  179.  
  180. :m $INSERT:  { str \ state -- }
  181.         \ Inserts the active text from the given relocatable
  182.         \ string, using early binding.  As the memory manager could 
  183.         \ move the source string to make room for the increase in 
  184.         \ length of SELF, we lock the source string for the
  185.         \ operation, then restore its previous state.
  186.  
  187.     str getState: string  -> state  str lock: string
  188.     str get: string  insert: self
  189.     state  str setState: string  ;m
  190.  
  191.  
  192. :m ADD: { addr len -- }
  193.     end: self
  194.     addr len  insert: self  ;m
  195.  
  196.  
  197. :m $ADD:  { str \ state -- }
  198.     str getState: string  -> state  str lock: string
  199.     str get: string  add: self
  200.     state  str setState: string  ;m
  201.  
  202.  
  203. :m +:        \ ( char -- )  Appends a char to end of string
  204.     pad c!  pad 1 add: self  ;m
  205.  
  206.  
  207. :m PRINT:
  208.     nil?: self
  209.     if   Nopen  else   get: self  type   then   ;m
  210.  
  211. \ :m   =: { theobj -- }
  212. \        \ Assigns this string to any object that accepts ( addr len )
  213. \    get: self  put: theobj  ;m
  214.  
  215. :m FILL:    \ ( c -- )
  216.     get: self  rot  fill  ;m
  217.  
  218.  
  219. \ SEARCH: and CHSEARCH: are somewhat interim.  Class String+ provides more
  220. \ efficient versions which also include case handling.  But these versions
  221. \ are short, and may be adequate for many needs.
  222.  
  223. :m SEARCH:    \ ( addr len -- b )
  224.     0 0  munger: self
  225.     dup 0< if  drop  false  else  put: lim  true  then  ;m
  226.  
  227. :m CHSEARCH:    \ ( c -- b )
  228.     pad c!  pad 1  search: self  ;m
  229.  
  230.  
  231. :m DUMP:  { \ indent offs svCurs -- }
  232.     nil?: self  if  Nopen  exit  then
  233.     curs -> svCurs  -curs  out
  234.     all: self  swap .h .h
  235.     out swap -  -> indent
  236.     pos: self 5 - 0 max  -> offs
  237.     all: self  swap offs +  swap offs -  80 min  bounds
  238.     do  i c@  bl 126 within?
  239.         nif  ret = if  $ A6  else  $ D7  then
  240.         then
  241.         emit
  242.     loop  cr
  243.     out  pos: self  .h
  244.     pos: self  offs -  indent +  out -  +  spaces  & P  emit  cr
  245.     out  lim: self  .h
  246.     lim: self  offs -  indent +  out -  +
  247.     dup 80 < if  spaces  & L  emit  else  drop  then
  248.     ^1st: self  len: self  0 max  $ 140  min  dump
  249.     svCurs -> curs  ;m
  250.  
  251. :m RD:    reset: self  dump: self  ;m        \ Handy, and short to type!
  252.  
  253. ;class
  254.  
  255. <" Files
  256.